home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Network Support Library
/
RoseWare - Network Support Library.iso
/
apidev
/
basnet.arc
/
NODEINFO.BAS
< prev
next >
Wrap
BASIC Source File
|
1987-05-11
|
28KB
|
691 lines
10 'Initialization
15 GOSUB 10000 'set up the network access and library calls
17 '
50 CLS
90 PRINT " SHELL STATUS TABLES"
100 PRINT "------------------------------------------------------------------------------"
105 PRINT "LOG DRV A B C D E F G H I J K L M N O P Q R S T U V W"
107 PRINT " NAME : X Y Z [ \ ] ^ - `"
200 '
210 'Display Drive Handle Table
220 '
230 mode% = 0
365 TABLENAM$="DRV HDL: "
370 GOSUB 16000
400 '
410 'Display the Drive Flag Table
420 '
430 mode% = 1
440 TABLENAM$="DRV FLG: "
450 GOSUB 16000
480 '
490 'Display Drive Server Table
500 '
510 mode% = 2
520 TABLENAM$="DRV SRV: "
530 GOSUB 16000
540 '
541 PRINT "______________________________________________________________________________"
542 MODE% = 2 'GET THE CURRENT EFFECTIVE SERVER
543 DEF SEG = LIBSEG
544 CALL SETSERV(MODE%,DRIVE%,CURR%)
545 DEF SEG
547 MODE% = 3 'get server mapping table address function
550 '
553 DEF SEG = LIBSEG
557 CALL GETSTA(MODE%, STSEGMENT%, STOFFSET%) 'Func EFh
560 MODE% = 4
563 CALL GETSTA(MODE%,STSEGMENT%,NTOFF%) 'Func EFh
567 DEF SEG = STSEGMENT%
570 '
573 ' Now we will display the table contents for demo purposes
575 LOCATE 13,31
577 PRINT "Server mapping table contents:": PRINT
580 FOR I = 0 TO 7
584 T=15 + I
585 LOCATE T,30
586 PRINT I+1;:IF I+1=CURR% THEN PRINT "* "; ELSE PRINT " ";
587 FOR X = 0 TO 13
590 PRINT RIGHT$("00"+HEX$(PEEK(STOFFSET% + (32*I) + X)),2);
593 NEXT X
597 PRINT SPC(3);
600 FOR X = 0 TO 19
603 A$ = CHR$(PEEK(NTOFF% + (I*48) + X))
607 IF A$ = CHR$(0) THEN X = 19 ELSE PRINT A$;
610 NEXT X
613 PRINT
617 NEXT I
620 '
630 LOCATE 13,1
650 PRINT "--------- MAIN MENU -------"
651 PRINT " 1. ATTACH (F1h mode=0)"
652 PRINT " 2. DETACH (F1h mode=1)"
653 PRINT " 3. LOGOUT (F1h mode=2)"
654 PRINT " 4. LOGIN (E3h-00h)"
657 PRINT " 5. SET PREFERRED SERVER"
658 PRINT " 6. GET DRIVE INFORMATION"
662 PRINT " 7. SET PATH(Allocate a base)"
666 PRINT " 8. ADD A SUBDIRECTORY"
670 PRINT " 9. EXIT program"
674 PRINT "---------------------------"
678 INPUT ; "Please make a menu selection: ",RE$
680 IF (RE$ <"1") OR (RE$>"9") THEN 50
682 ON VAL(RE$) GOSUB 1000,2000,3000,4000,5000,6000,7000,8000
684 IF RE$ = "9" THEN 999
686 GOTO 50
999 SYSTEM
1000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
1010 ' Begin ATTACH
1020 CLS
1025 PRINT "SERVER NAME
1030 PRINT "-----------
1035 PRINT
1040 LASTOBJECTID$ = STRING$(4,255)
1045 RETURNCODE% = 0
1050 PATTERNTYPEHI$ = CHR$(0)
1055 PATTERNTYPELO$ = CHR$(4)
1060 REQPACLENHI$ = CHR$(0)
1065 REQPACLENLO$ = CHR$(9)
1070 FUNC$ = CHR$(55) 'scan for objects subfunction
1075 PATTERNLEN$ = CHR$(1)
1080 PATTERN$ = "*"
1085 REPPACLENHI$ = CHR$(0)
1090 REPPACLENLO$ = CHR$(57)
1095 WHILE RETURNCODE% <> 252
1100 'set up the request buffer
1105 OBJREQ$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + LASTOBJECTID$ + PATTERNTYPEHI$ + PATTERNTYPELO$ + PATTERNLEN$ + PATTERN$
1110 'set up the reply buffer
1115 OBJREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$((ASC(REPPACLENHI$)*256) + ASC(REPPACLENLO$),"x")
1120 'make the bindery request
1125 DEF SEG = LIBSEG
1130 CALL SYSLOG(RETURNCODE%,OBJREQ$,OBJREPLY$)
1135 DEF SEG
1140 IF RETURNCODE% <> 252 THEN PRINT MID$(OBJREPLY$,9,48) ELSE OBJREPLY$ = STRING$(60,CHR$(0))
1145 LASTOBJECTID$ = MID$(OBJREPLY$,3,4)
1150 WEND
1155 print
1160 INPUT "Enter file server name you wish to attach to: ",SERVERNAME$
1165 IF SERVERNAME$ = "" THEN GOTO 1999
1170 ' now get the net address of the server
1175 GOSUB 18000
1180 IF PROPRETCODE% <> 0 THEN GOTO 1999
1190 '
1210 ' now check the table for target server match and an open entry to use
1220 SERVERMATCH% = 0: INSERT% = 0
1225 DEF SEG = STSEGMENT%
1230 FOR ENTRY% = 7 TO 0 STEP -1
1250 IF PEEK(STOFFSET% + (32 * ENTRY%)) <> 255 THEN INSERT% = ENTRY%+1: GOTO 1280
1251 DMY$ = ""
1252 FOR I = 2 TO 13
1254 DMY$ = DMY$ + CHR$(PEEK(STOFFSET%+32*ENTRY%+I))
1256 NEXT I
1258 IF TARGETADDRESS$ = DMY$ THEN SERVERMATCH% = ENTRY% + 1: GOTO 1290
1280 NEXT
1290 DEF SEG
1295 IF SERVERMATCH% THEN INPUT "That server is in the table. <enter>",V$:GOTO 1999
1400 '
1405 ' we now need to insert our server address into the table.
1410 '
1500 IF INSERT% = 0 THEN INPUT "There are no free entries. <enter>",V$: GOTO 1999
1520 TARGETBASEADD% = STOFFSET% + (32 * (INSERT% -1))
1590 DEF SEG = STSEGMENT%
1600 FOR CHARNO% = 1 TO 12
1620 THISCHAR% = ASC(MID$(TARGETADDRESS$,CHARNO%,1))
1630 THISADD% = TARGETBASEADD% + CHARNO% + 1
1640 POKE THISADD%,THISCHAR%
1660 NEXT
1662 FOR X% = 1 TO LEN(SERVERNAME$)
1664 THISCHAR% = ASC(MID$(SERVERNAME$,X%,1))
1665 THISADDR% = STOFFSET% + 8*32 + (INSERT% - 1)*48 + X% - 1
1666 POKE THISADDR%,THISCHAR%
1668 NEXT
1669 POKE THISADDR%+1,0
1670 DEF SEG
1700 '
1705 ' now we need to set the order numbers for the server mapping table
1710 SLOT% = 1 'initialize the variable for a value higher than the table can hold
1715 DEF SEG = STSEGMENT%
1720 FOR CHKENTRY% = 0 TO 7
1730 THISOFF% = STOFFSET% + (32*CHKENTRY%)
1740 IF PEEK(THISOFF%) <> 255 THEN GOTO 1770
1745 DMY$ = ""
1750 FOR I = 2 TO 13
1752 DMY$ = DMY$ + CHR$(PEEK(THISOFF% + I))
1754 NEXT
1756 IF TARGETADDRESS$ > DMY$ THEN SLOT% = SLOT% + 1: GOTO 1770
1758 POKE THISOFF%+1,PEEK(THISOFF%+1)+1
1770 NEXT
1780 '
1810 ' we need to set the in use flag for our new entry and the new order #
1830 POKE TARGETBASEADD%, 255:POKE TARGETBASEADD%+1,SLOT%
1890 '
1900 ' finally, we must make the call to attach to our new server
1905 ' (Function Call F1h)
1910 MODE% = 0 'mode to create an attachment
1920 RETCODE% = 0
1930 DEF SEG = LIBSEG
1940 CALL MODSERV(MODE%,SLOT%,RETCODE%) 'Func F1h
1950 DEF SEG
1960 IF RETCODE% <> 0 THEN INPUT "Attempt to attach failed <RETURN> to continue.",R$
1999 RETURN
2000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
2005 'Begin DETACH
2007 '
2008 LOCATE 24,1
2010 INPUT "Enter Server Mapping Table entry (1-8) to be DETACHED: ",DL$
2020 IF DL$ = "" THEN 2999
2030 DL% = VAL(DL$)
2040 IF (DL% < 1) OR (DL% > 8) THEN 2008
2050 MODE% = 1
2060 RETCODE% = 0
2070 DEF SEG = LIBSEG
2080 CALL MODSERV(MODE%,DL%,RETCODE%) 'Func F1h
2090 DEF SEG
2100 IF RETCODE% <> 0 THEN PRINT "Not detached! Return code -> "RETCODE%: INPUT " <enter>",v$: goto 2999
2110 INPUT "DETACH Completed. <enter>",V$
2999 RETURN
3000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
3005 ' Begin LOGOUT
3007 '
3009 LOCATE 24,1
3010 INPUT "Enter Server Mapping Table entry (1-8) to be LOGOUT of: ",DL$
3020 IF DL$ = "" THEN 3999
3030 DL% = VAL(DL$)
3040 IF (DL% < 1) OR (DL% > 8) THEN 3009
3050 MODE% = 2
3060 RETCODE% = 0
3070 DEF SEG = LIBSEG
3080 CALL MODSERV(MODE%,DL%,RETCODE%) 'Func F1h
3090 DEF SEG
3100 IF RETCODE% <> 0 THEN PRINT "Not LOGGED OUT! Return code -> "RETCODE%: INPUT "<enter>",v$: goto 3999
3110 INPUT "LOGOUT Completed. <enter>",V$
3999 RETURN
4000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
4010 ' Begin LOGIN
4010 '
4020 ' first we need to select the file server which is the target
4030 ' of our request
4040 '
4041 LOCATE 24,1
4042 INPUT "Enter slot # of the server to be logged in to: ",SLOT$
4043 IF SLOT$ = "" THEN 4999
4044 SLOT% = VAL(SLOT$)
4046 IF (SLOT%<1) OR (SLOT%>8) THEN GOTO 4041
4050 MODE% = 0 'mode to set the preferred file server
4060 DEF SEG = LIBSEG
4070 CALL SETSERV(MODE%,SLOT%,CURRENTSERVER%) 'Func F0h
4080 DEF SEG
4200 ' and now we will log in
4210 ' set up the request packet
4212 INPUT "Enter login name: ",LOGNAME$
4220 REQPACLENHI$ = CHR$(0)
4230 REQPACLENLO$ = CHR$(LEN(LOGNAME$)+3)
4240 FUNC$ = CHR$(0) 'login subfunction
4250 LOGNAMELEN$ = CHR$(LEN(LOGNAME$))
4270 PASSWORDLEN$ = CHR$(0)
4280 PASSWORD$ = ""
4290 REQPACKET$ = REQPACLENLO$+REQPACLENHI$+FUNC$+LOGNAMELEN$+LOGNAME$+PASSWORDLEN$
4300 ' set up the reply buffer
4310 REPPACLENHI$ = CHR$(0)
4320 REPPACLENLO$ = CHR$(20)
4330 REPLYPACKET$ = REPPACLENLO$+REPPACLENHI$
4340 'make the login request
4350 DEF SEG = LIBSEG
4360 CALL SYSLOG(ERRCODE%,REQPACKET$,REPLYPACKET$) 'Func E3h(00h)
4370 DEF SEG
4380 IF ERRCODE% <> 0 THEN PRINT "Error -> "ERRCODE%: INPUT "<enter>",V$: GOTO 4041
4390 INPUT "login successful <enter>",v$
4999 RETURN
5000 'SET THE PREFERRED FILE SERVER
5005 LOCATE 24,1
5010 input "Set preferred file server as (1-8): ",drive%
5030 MODE% = 0 'mode to set the preferred file server
5040 DEF SEG = LIBSEG
5050 CALL SETSERV(MODE%,DRIVE%,CURRENTSERVER%)
5060 DEF SEG
5070 RETURN
6000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
6010 CLS
6020 ' Begin GET DRIVE INFORMATION
6030 '
6032 INPUT "Select drive (0 thru 31): ",v$
6035 IF V$ = "" THEN GOTO 6999
6040 DRIVE% = VAL(V$)
6045 IF DRIVE% < 0 OR DRIVE% > 31 THEN GOTO 6010
6050 'now get the path base
6055 '
6060 ReturnFlags% = 0
6065 def seg = LibSeg
6070 call drvmap(ReturnFlags%,Drive%)
6075 def seg
6080 BaseFlag% = ReturnFlags%/256 ' the base flag is the high byte of the return
6085 PathBase% = (ReturnFlags% - (BaseFlag% * 256)) ' the path base is the low byte of the return
6095 'next we can get the path itself
6100 '
6105 Func$ = chr$(1)
6110 SourceBase$ = chr$(PathBase%)
6115 ReqPacLenHi$ = chr$(0)
6120 ReqPacLenLo$ = chr$(2)
6125 ReqPacket$ = ReqPacLenLo$ + ReqPacLenHi$ + Func$ + SourceBase$
6130 Reply$ = chr$(64)+chr$(0) + string$(64,0)
6135 ReturnCode% = 0
6140 def seg = LibSeg
6145 call dpath(ReturnCode%,ReqPacket$,Reply$)
6150 def seg
6155 RetPathLen% = asc(mid$(Reply$,3,1))
6160 Path$ = mid$(Reply$,4,RetPathLen%)
6165 print "The current path is " Path$
6170 ' now we find out what rights the directory allows
6175 '
6180 Func$ = chr$(2)
6185 SourceBase$ = chr$(0)
6190 SearchStart$ = chr$(0) + chr$(1)
6200 SpecLength$ = chr$(len(Path$))
6205 LoPacLen$ = chr$(5+len(Path$))
6210 HiPacLen$ = chr$(0)
6215 Request$ = LoPacLen$ + HiPacLen$ + Func$ + SourceBase$ + SearchStart$ + SpecLength$ + Path$
6220 Reply$ = chr$(28)+chr$(0) + string$(28,0)
6225 ErrCode% = 0
6230 def seg = LibSeg
6235 call dpath(ErrCode%,Request$,Reply$)
6240 def seg
6245 if ErrCode% <> 0 then PRINT "Request for allowable directory rights failed. <enter> ",v$: goto 6320
6250 Access% = asc(mid$(Reply$,27,1))
6255 print "This directory permits the following rights: "
6260 PRINT " (";
6265 if Access% > 127 then print "Modify";:Access% = Access% - 128
6270 if Access% > 63 then print ", Search";:Access% = Access% - 64
6275 if Access% > 31 then print ", Parental";:Access% = Access% - 32
6290 if Access% > 15 then print ", Delete";:Access% = Access% - 16
6295 if Access% > 7 then print ", Create";:Access% = Access% - 8
6300 if Access% > 3 then print ", Open";:Access% = Access% - 4
6305 if Access% > 1 then print ", Write";:Access% = Access% - 2
6310 if Access% > 0 then print ", Read";:Access% = Access% - 1
6315 PRINT ")"
6320 ' the next step is to discover which rights we have in this
6325 ' directory
6330 '
6335 Func$ = chr$(3)
6345 LoPacLen$ = chr$(3+len(Path$))
6350 HiPacLen$ = chr$(0)
6355 Request$ = LoPacLen$ + HiPacLen$ + Func$ + SourceBase$ + SpecLength$ + Path$
6360 Reply$ = chr$(1) + chr$(0) + chr$(0)
6365 ErrCode% = 0
6370 def seg = LibSeg
6375 call dpath(ErrCode%,Request$,Reply$)
6380 def seg
6385 if ErrCode% <> 0 then print "Request for your effective directory rights failed.": GOTO 6450
6390 Access% = asc(mid$(Reply$,3,1))
6395 print "Your rights in this directory are: "
6400 PRINT " (";
6405 if Access% > 127 then print "Modify";:Access% = Access% - 128
6410 if Access% > 63 then print ", Search";:Access% = Access% - 64
6415 if Access% > 31 then print ", Parental";:Access% = Access% - 32
6420 if Access% > 15 then print ", Delete";:Access% = Access% - 16
6425 if Access% > 7 then print ", Create";:Access% = Access% - 8
6430 if Access% > 3 then print ", Open";:Access% = Access% - 4
6435 if Access% > 1 then print ", Write";:Access% = Access% - 2
6440 if Access% > 0 then print ", Read";:Access% = Access% - 1
6445 PRINT ")"
6450 ' NEXT LIST ALL TRUSTEES OF THIS DIRECTORY
6455 ErrCode% = 0
6460 SetNo% = 1
6465 func$ = chr$(12) 'E2h function 12 gets trustees
6470 while ErrCode% = 0
6490 SetNo$ = chr$(SetNo%)
6505 Request$ = Func$ + SourceBase$ + SetNo$ + SpecLength$ + path$
6506 request$ = chr$(len(request$)) + chr$(0) + request$
6510 Reply$ = chr$(49) + chr$(0) + string$(49,chr$(0))
6515 def seg = LibSeg
6520 call dpath(ErrCode%,Request$,Reply$)
6525 def seg
6530 if ErrCode% <> 0 and SetNo% = 1 then print "(This directory has no trustees.";:goto 6625
6535 if ErrCode% <> 0 then goto 6625
6540 PRINT "The trustees of this directory are:"
6545 print " (";
6550 Trustee# = 1 : count% = 0
6555 while Trustee# <> 0 and count% < 5
6560 offset% = 27 + (count% * 4)
6565 Trustee# = asc(mid$(Reply$,offset% ,1)) + (256 * asc(mid$(Reply$,offset% + 1,1))) + (256 * 256 * asc(mid$(Reply$,offset% + 2,1)))
6566 trustee# = trustee# + (256*256*256* asc(mid$(reply$,offset%+3,1)))
6570 if Trustee# = 0 then goto 6625
6575 GetTrusteeName$ = chr$(5) + chr$(0) + chr$(54) + mid$(Reply$,offset%,4)
6580 TrusteeNameResponse$ = chr$(56) + chr$(0) + string$(56,0)
6585 RetCode% = 0
6590 def seg = LibSeg
6595 call syslog(RetCode%, GetTrusteeName$, TrusteeNameResponse$)
6600 def seg
6605 if RetCode% = 0 then print spc(1) mid$(TrusteeNameResponse$,9,48);
6610 if RetCode% <> 0 then count% = 5
6615 count% = count% + 1
6620 wend
6625 SetNo% = SetNo% + 1
6630 wend
6635 print ")"
6640 ' NEXT TOTAL DISK SPACE USED IN THIS DIRECTORY
6645 func$ = chr$(15)
6650 lastslot$ = chr$(255) + chr$(255)
6655 searchattrib$ = chr$(0)
6656 spec$ = path$ + "\*": specln$ = chr$(len(spec$))
6660 done% = 0: total# = 0:
6670 while done% = 0
6675 request$ = func$ + lastslot$ + sourcebase$ + searchattrib$ + specln$ + spec$
6680 request$ = chr$(len(request$)) + chr$(0) + request$
6685 reply$ = chr$(96)+chr$(0) + string$(96,0)
6689 def seg = libseg
6690 call syslog(done%, request$, reply$)
6691 def seg
6695 if done% <> 0 then print "The total bytes used in this directory is: "total#: goto 6710
6700 total# = total# + 256*256*256*asc(mid$(reply$,21,1))
6701 total# = total# + 256*256*asc(mid$(reply$,22,1))
6702 total# = total# + 256*asc(mid$(reply$,23,1))
6703 total# = total# + asc(mid$(reply$,24,1))
6705 lastslot$ = mid$(reply$,3,2)
6710 wend
6720 ' NEXT LIST ALL SUBDIRECTORIES
6725 func$ = chr$(2)
6730 hisearch% = 0: losearch% = 1 :s = 0
6735 done% = 0
6740 print "The Subdirectories are: "
6745 def seg = libseg
6750 while done% = 0
6755 request$ = func$ + sourcebase$ + chr$(hisearch%) + chr$(losearch%) + specln$ + spec$
6760 request$ = chr$(len(request$)) + chr$(0) + request$
6765 reply$ = chr$(28)+chr$(0) + string$(28,0)
6770 call dpath(done%, request$, reply$)
6775 if done% <> 0 then goto 6790
6780 print spc(3)mid$(reply$,3,16);
6783 hisearch% = asc(mid$(reply$,29,1))
6784 losearch% = asc(mid$(reply$,30,1))
6785 if s = hisearch% * 256 + losearch% then done% = 1: goto 6790
6786 s = hisearch% + losearch%
6787 losearch% = losearch% + 1
6788 if losearch% > 255 then losearch% = 0 and hisearch% = hisearch% + 1
6790 wend
6795 def seg
6800 PRINT
6805 INPUT "<enter> ",v$
6999 return
7000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
7005 CLS
7010 ' Begin SET PATH
7015 '
7020 ' This routine demonstrates the ability of a program to set a
7030 ' a permanent base path.
7040 '
7110 'set up a base for exit purposes
7120 'set up request packet
7125 '
7127 PRINT "Menu Option 7 - SET PATH"
7128 PRINT
7130 INPUT "Allocate Base as 'P'ermanent or 'T'emporary: ",ANS$:PRINT
7131 IF ANS$ = "" THEN GOTO 7399
7132 IF ASC(ANS$) > 96 THEN ANS$ = CHR$(ASC(ANS$)-32)
7135 IF (ANS$ <> "P") AND (ANS$ <> "T") THEN 7130
7150 FUNC$ = CHR$(18)
7155 IF ANS$ = "T" THEN FUNC$ = CHR$(19)
7160 SOURCEBASE$ = CHR$(0)
7170 INPUT "Enter a logical drive name (A to ` ): ",DRIVENAME$:PRINT
7171 IF DRIVENAME$ = "" THEN 7399
7174 IF ASC(DRIVENAME$) > 96 THEN DRIVENAME$ = CHR$(ASC(DRIVENAME$)-32)
7177 IF (DRIVENAME$ < "A") OR (DRIVENAME$ > "`") THEN 7170
7190 INPUT "Enter Path Name specification (SYS:PUBLIC/COMMON): ",PATHSPEC$:PRINT
7192 SPECLEN$ = CHR$(LEN(PATHSPEC$))
7194 REQPACLENHI$ = CHR$(0)
7196 REQPACLENLO$ = CHR$(4 + LEN(PATHSPEC$))
7200 'set up reply buffer
7210 REPLENHI$ = CHR$(0)
7220 REPLENLO$ = CHR$(2)
7230 NEWBASE$ = " "
7240 ACCESSMASK$ = " "
7250 REQUESTBLOCK$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + SOURCEBASE$ + DRIVENAME$ + SPECLEN$ + PATHSPEC$
7260 REPLY$ = REPLENLO$ + REPLENHI$ + NEWBASE$ + ACCESSMASK$
7270 DEF SEG = LIBSEG
7280 CALL DPATH(RETURNCODE%, REQUESTBLOCK$, REPLY$) 'Func E2h(12h)
7290 IF RETURNCODE% <> 0 THEN PRINT "Path Error: " RETURNCODE%:PRINT:GOTO 7300
7292 PRINT PATHSPEC$;" has been mapped to drive ";DRIVENAME$:PRINT
7300 DEF SEG
7310 input "<RETURN> to continue.",r$
7399 RETURN
8000 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
8005 CLS
8010 ' Begin ADD SUBDIRECTORY
8015 '
8020 ' makes a subdirectory below the current directory
8030 '
8040 ' first get the current drive
8050 '
8055 PRINT "Menu Option 8 - ADD SUBDIRECTORY"
8057 PRINT
8060 DRIVE% = 0
8070 DEF SEG = LIBSEG
8080 CALL GETDRV(DRIVE%) 'DOS Func call 19h
8090 DEF SEG
8100 '
8110 'now get the path base
8120 '
8130 RETURNFLAGS% = 0
8140 DEF SEG = LIBSEG
8150 CALL DRVMAP(RETURNFLAGS%,DRIVE%) 'Func E9h
8160 DEF SEG
8170 BASEFLAG% = RETURNFLAGS%/256 ' the base flag is the high byte of the return
8180 pathbase% = (RETURNFLAGS% - (BASEFLAG% * 256)) ' the path base is the low byte of the return
8200 '
8210 'next we can get the path itself
8220 '
8230 FUNC$ = CHR$(1)
8240 SOURCEBASE$ = CHR$(pathbase%)
8250 REQPACLENHI$ = CHR$(0)
8260 REQPACLENLO$ = CHR$(2)
8270 REQPACKET$ = REQPACLENLO$ + REQPACLENHI$ + FUNC$ + SOURCEBASE$
8280 REPLY$ = CHR$(&H40) + CHR$(0) + STRING$(64,CHR$(0))
8290 RETURNCODE% = 0
8300 DEF SEG = LIBSEG
8310 CALL DPATH(RETURNCODE%,REQPACKET$,REPLY$) 'Func E2h(01h)
8320 DEF SEG
8330 PATH$ = MID$(REPLY$,4,63)
8340 INCOMING$ = PATH$
8350 GOSUB 11000 'subroutine to strip nulls from the string
8360 PATH$ = OUTGOING$
8400 '
8410 'Now add the subdirectory
8420 '
8440 FUNC$ = CHR$(10)
8450 ' use the current source base
8470 INPUT "NAME YOUR SUBDIRECTORY: ",PATHSPEC$:PRINT
8480 IF PATHSPEC$ = "" THEN GOTO 8699
8490 SPECLENGTH$ = CHR$(LEN(PATHSPEC$))
8500 LOPACLEN$ = CHR$(4+LEN(PATHSPEC$))
8510 HIPACLEN$ = CHR$(0)
8520 REQUEST$ = LOPACLEN$ + HIPACLEN$ + FUNC$ + SOURCEBASE$ +CHR$(0) + SPECLENGTH$ + PATHSPEC$
8530 REPLY$ = CHR$(0) + CHR$(0)
8540 ERRCODE% = 0
8550 DEF SEG = LIBSEG
8560 CALL DPATH(ERRCODE%,REQUEST$,REPLY$) 'Func E2h(0Ah)
8570 DEF SEG
8580 IF ERRCODE% <> 0 THEN PRINT:PRINT "Request failed. Error code " ERRCODE%:PRINT:GOTO 8470
8590 PRINT "'";PATHSPEC$;"'";" was created as a subdirectory in ";PATH$
8592 PRINT
8595 INPUT "<RETURN> to continue",S$
8699 RETURN
10000 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
10010 ' routines for network use
10020 '
10100 ' This file contains the routine names and
10101 ' offsets for the BASNET library
10110 XTNDOPN = 0 'xtndopn(Mode%, Filename$, Handle%, ErrCode%)
10111 SETATTR = 3 'setattr(Func%, Filename$, Attribute%, ErrCode%)
10112 EOJSTAT = 6 'eojstat(Flag%)
10113 PRLH.LOG = 9 'PRLH.Log(FileHandle%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
10114 PRLH.REL = 12 'PRLH.Rel(FileHandle%,HiByteOffset%,LoByteOffset%,ErrCode%)
10115 PRLH.CLR = 15 'PRLH.Clr(FileHandle%,HiByteOffset%,LoByteOffset%,Errcode%)
10116 PRLF.LOG = 18 'PRLF.Log(fcb%,HiByteOffset%,LoByteOffset%,HiLockLen%,LoLockLen%,Flags%,TimeOut%,ErrCode%)
10117 PRLF.REL = 21 'PRLF.Rel(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
10118 PRLF.CLR = 24 'PRLF.Clr(fcb%,HiByteOffset%,LoByteOffset%,ErrCode%)
10119 PRLS.LCK = 27 'PRLS.Lck(Flags%,TimeOut%,ErrCode%)
10120 PRLS.REL = 30 'PRLS.Rel(ErrCode%)
10121 PRLS.CLR = 33 'PRLS.Clr(ErrCode%)
10122 OPENSEM = 36 'OpenSem(Sema4$,SemaValu%,HiHandle%,LoHandle%,OpenCnt%,RetCode%)
10123 EXAMSEM = 39 'ExamSem(HiHandle%,LoHandle%,SemaValu%,OpenCnt%,RetCode%)
10124 WAITSEM = 42 'WaitSem(HiHandle%,LoHandle%,TimeOut%,RetCode%)
10125 SIGSEM = 45 'SigSem(HiHandle%,LoHandle%,RetCode%)
10126 CLOSSEM = 48 'ClosSem(HiHandle%,LoHandle%,RetCode%)
10127 SETLCK = 51 'setlck(Func%,Mode%)
10128 BAKOUTS = 54 'Bakouts(Func%,RetCode%)
10129 BTRANS = 57 'btran(ReturnCode%, Mode%)
10130 ETRANS = 60 'etrans(ReturnCode%)
10131 EXCLOG = 63 'exclog(ReturnCode%, FcbAddr)
10132 EXCLCKS = 66 'exclcks(ReturnCode%, Mode%)
10133 EXCULKF = 69 'exculkf(ReturnCode%, FcbAddr)
10134 EXCULKS = 72 'exculks(ReturnCode%)
10135 EXCCLRF = 75 'excclrf(ReturnCode%, FcbAddr)
10136 EXCCLRS = 78 'excclrs(ReturnCode%)
10137 RECLOG = 81 'reclog(ReturnCode%, String$)
10138 RECLCK = 84 'reclck(ReturnCode%, Mode%)
10139 RECULK = 87 'reculk(ReturnCode%, Semaphore$)
10140 RECULKS = 90 'reculks(ReturnCode%)
10141 RECCLR = 93 'recclr(ReturnCode%, Semaphore$)
10142 RECCLRS = 96 'recclrs(ReturnCode%)
10143 EOJ = 99 'eoj(ReturnCode%)
10144 SYSOUT = 102 'sysout(ReturnCode%)
10145 ALLOCR = 105 'allocr(ReturnCode%, Resource%)
10146 DALLOCR = 108 'dallocr(ReturnCode%, Resource%)
10147 VOLSTAT = 111 'volstat(volume%, reply$)
10148 LOCDRV = 114 'locdrv(NumDisks%)
10149 WSID = 117 'wsid(ThisStationNum%)
10150 ERRMODE = 120 'errmode(mode%)
10151 BCSMODE = 123 'bcsmode(mode%)
10152 CTLSPL = 126 'ctlspl(mode%)
10153 SPLREQ = 129 'splreq(ErrCode%, RequestBlock$, Reply$)
10154 PIPREQ = 132 'pipreq(ErrCode%, RequestBlock$, Reply$)
10155 DPATH = 135 'dpath(ReturnCode%, RequestBlock$, Reply$)
10156 SYSLOG = 138 'syslog(ReturnCode%, RequestBlock$, Reply$)
10157 FATTR = 141 'fattr(ReturnCode%, FcbAddr, Attribute%)
10158 UPDFCB = 144 'updfcb(RetCode%,FcbAddr)
10159 CPYFILE = 147 'cpyfile(ReturnCode%, FcbSource, FcbDest, CountLow, CountHigh)
10160 NETTOD = 150 'nettod(time$)
10161 CLSMODE = 153 'clsmode(mode%)
10162 DRVMAP = 156 'drvmap(ReturnFlags%, drive%)
10163 RETSHL = 159 'retshl(RetCode%, Mode%)
10164 ASCLOG = 162 'asclog(RetCode%, Asciiz$)
10165 ASCULKF = 165 'asculkf(RetCode%, Asciiz$)
10166 ASCCLRF = 168 'ascclrf(RetCode%, Asciiz$)
10167 GETPSN = 171 'Get_PSN(StationNo%)
10168 GETSTA = 174 'Get_STA(Mode%,Segment%,Offset%)
10169 SETSERV = 177 'SetServ(Mode%,NewServ%,CurrServ%)
10170 MODSERV = 180 'ModServ(Mode%,NewServ%,RetCode%)
10171 GETDRV = 183 'GetDrv(Drive%)
10200 '
10210 ' Assign the segment address for the library to the variable LibSeg
10330 DEF SEG = 0
10331 SUBOFF = PEEK(&H4F0)+(256*PEEK(&H4F1))
10332 SUBSEG = PEEK(&H4F2)+(256*PEEK(&H4F3))
10333 LIBSEG = SUBSEG
10400 '
10410 ' set the error mode so its more informative
10420 DEF SEG = LIBSEG
10430 NEWMODE% = 1
10440 CALL ERRMODE(NEWMODE%)
10450 DEF SEG
10999 RETURN
11000 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
11005 ' routine to strip nulls from the right side of a string
11010 '
11020 OUTGOING$ = ""
11030 I = 0
11040 CHECKCHAR$ = CHR$(1)
11050 WHILE CHECKCHAR$ <> CHR$(0)
11060 I=I+1
11070 CHECKCHAR$=MID$(INCOMING$,I,1)
11080 IF CHECKCHAR$ <> CHR$(0) THEN OUTGOING$ = OUTGOING$ + CHECKCHAR$
11090 WEND
11999 RETURN
16000 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
16010 '
16100 ' Perform get and display shell tables routine
16110 '
16240 def seg = libseg
16250 call GETSTA(Mode%,DHTsegment%,DHToffset%) 'Func EFh
16260 def seg
16265 PRINT TABLENAM$;
16268 def seg = DHTsegment%
16270 for x=0 to 22
16282 IF MODE%=1 THEN PRINT RIGHT$(" " + HEX$(PEEK(DHTOFFSET% + X)),3);:GOTO 16290
16289 PRINT USING "###";PEEK(DHTOFFSET% + X);
16290 next x
16296 PRINT
16297 PRINT " ";
16298 for x=23 to 31
16300 IF MODE%=1 THEN PRINT RIGHT$(" " + HEX$(PEEK(DHTOFFSET% + X)),3);:GOTO 16310
16305 PRINT USING "###";PEEK(DHTOFFSET% + X);
16310 next x
16315 DEF SEG
16320 PRINT
16400 RETURN
18000 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
18005 ' set up the request packet to get the net address
18010 ' (Function Call E3h(3Dh) also see Function Call Ref pg. 8-5)
18030 '
18040 FUNC$ = CHR$(61) 'get a properites value subfunction 3Dh
18110 OBJTYPE$ = CHR$(0) + CHR$(4)
18120 OBJNAME$ = SERVERNAME$
18130 OBJNAMELEN$ = CHR$(LEN(OBJNAME$))
18140 SEGNUM$ = CHR$(1)
18150 PROPNAME$ = "NET_ADDRESS"
18160 PROPLEN$ = CHR$(LEN(PROPNAME$))
18190 PROPVALREQ$ = FUNC$ + OBJTYPE$ + OBJNAMELEN$ + OBJNAME$ + SEGNUM$ + PROPLEN$ + PROPNAME$
18192 LGTH$ = CHR$(LEN(PROPVALREQ$)) + CHR$(0)
18195 PROPVALREQ$ = LGTH$ + PROPVALREQ$
18200 ' set up the reply buffer
18210 REPPACLENHI$ = CHR$(0)
18220 REPPACLENLO$ = CHR$(130)
18230 PROPVALREPLY$ = REPPACLENLO$ + REPPACLENHI$ + STRING$(130," ")
18300 'make the bindery request
18310 DEF SEG = LIBSEG
18320 CALL SYSLOG(PROPRETCODE%,PROPVALREQ$,PROPVALREPLY$) 'Func E3h(3Dh)
18330 DEF SEG
18340 IF PROPRETCODE% <> 0 THEN INPUT "No address was found for that Server. <ENTER>",V$:RETURN
18345 '
18350 ' we will put the address in a string to use later
18360 TARGETADDRESS$ = MID$(PROPVALREPLY$,3,12)
18370 ' for demo purposes we will print the address if we found one
18372 NTW$=""
18375 FOR I = 3 TO 14
18380 NTW$= NTW$+RIGHT$("00"+HEX$(ASC(MID$(PROPVALREPLY$,I,1))),2)
18390 NEXT I
18400 NET$ = MID$(NTW$,1,8): NODE$ = MID$(NTW$,9,12): SOC$ = MID$(NTW$,21,4)
18430 PRINT "NET is " NET$" NODE is " NODE$" SOCKET is " SOC$
18440 INPUT " <enter>",V$
18999 RETURN